library(tidyverse)
library(patchwork)
library(knitr)
library(dplyr)
library(gganimate)
library(gifski)
library(png)
library(plotly)
library(ggridges)
year_df=read_csv("data/AdultTrends.csv") %>%
janitor::clean_names() %>%
pivot_longer(cols=c("female", "male"),
names_to = "sex",
values_to = "age_adjust_prev") %>%
ggplot(aes(x=year,y=age_adjust_prev,col=sex))+geom_line()+geom_point()
year_df+transition_reveal(year)
edu_plot=slp_df %>%
filter(weekday_slp_hr<6)%>%
group_by(education_level,gender) %>%
summarize(ave_sleep=mean(weekday_slp_hr)) %>%
ungroup() %>%
mutate(education_level=fct_reorder(education_level,ave_sleep)) %>%
ggplot(aes(x=education_level,y=ave_sleep,fill=gender))+ geom_bar(width=0.5,stat="identity")+
viridis::scale_fill_viridis(
name = "gender",
discrete = TRUE
) + geom_text(aes(label = round(ave_sleep, 2)),position = position_stack(vjust=0.9), color = "white", size = 4)+
theme(axis.text.x = element_text(angle = -90, vjust = 0.5, hjust=1))
ggplotly(edu_plot)
race_plot=slp_df %>%
filter(weekday_slp_hr<6) %>%
group_by(race,weekday_slp_hr) %>%
summarise(obs=n()) %>%
plot_ly(
x = ~weekday_slp_hr, y = ~race, z = ~obs, type = "heatmap", colors = "BuPu"
) %>%
colorbar(title = "Number of People", x = 1, y = 0.5)
race_plot
gender_plot= slp_df %>%
filter(weekday_slp_hr<6) %>%
group_by(race,education_level) %>%
summarize(total_f=sum(gender=="female"),
total_m=sum(gender=="male"),
gap=total_m-total_f) %>%
mutate(text_lable=str_c("Race=",race,"\nEducation level: ", education_level)) %>%
plot_ly(x=~total_f,y=~total_m,text=~text_lable,color=~race,size=~gap,type="scatter",mode="markers",
colors="viridis",sizes = c(50, 700), marker = list(opacity = 0.7))
layout(gender_plot, title = "Race Gender Gap by Education Level", xaxis = list(title = "Number of Female Sleeping less than 6 hrs"), yaxis = list(title = "Number of Male Sleeping less than 6 hrs"))
income_df=slp_df %>%
filter(weekday_slp_hr<6) %>%
mutate(ip_stat=case_when(income_poverty_ratio > 1 ~ "not in poverty",
income_poverty_ratio < 1~ "in poverty",
income_poverty_ratio == 1~ "in poverty")) %>%
ggplot(aes(x=weekday_slp_hr,y=ip_stat,fill=ip_stat))+
geom_density_ridges(
aes(point_color = ip_stat, point_shape = ip_stat,point_fill=ip_stat),
alpha = .3, point_alpha = 0.7)+
scale_x_continuous(
breaks = c(2, 4, 6),
labels = c("2hrs", "4hrs", "6hrs"),
limits = c(2, 6)
)+ scale_fill_manual(values = c("#fde725","#440154"))
box_plot=
slp_df %>%
filter(weekday_slp_hr<6) %>%
mutate(ip_stat=case_when(income_poverty_ratio > 1 ~ "not in poverty",
income_poverty_ratio < 1~ "in poverty",
income_poverty_ratio == 1~ "in poverty")) %>%
ggplot(aes(x=ip_stat,y=weekday_slp_hr))+geom_boxplot(aes(fill = ip_stat), alpha = 0.3)+
scale_fill_manual(values = c("#fde725","#440154")) +
geom_hline(aes(yintercept=median(weekday_slp_hr)),
color="red", linetype="dashed")+
geom_text(aes(0, median(weekday_slp_hr), label = "sleep hours median"), vjust = -0.5, hjust = 0, color = "red")
income_df+box_plot
age_group= slp_df%>%
filter(weekday_slp_hr<6) %>%
mutate(age_gp=case_when(age>=20 & age<=30 ~ "20-30",
age>=31 &age <=40 ~ "31-40",
age>=41 &age<=50 ~ "41-50",
age>=51 &age<=60 ~ "51-60",
age>=61 &age<=70 ~ "61-70",
age>=71 & age <=80 ~ "71-80")) %>%
group_by(age_gp) %>%
summarise(ave_slp=mean(weekday_slp_hr))%>%
ungroup() %>%
mutate(age_gp=fct_reorder(age_gp,ave_slp)) %>%
ggplot(aes(x=age_gp,y=ave_slp,fill=age_gp))+ geom_bar(stat="identity")+ scale_fill_viridis_d()+
theme(axis.text.x = element_text(angle = -90, vjust = 0.5, hjust=1))+
geom_text(aes(label = round(ave_slp, 2)),position = position_stack(vjust=0.9), color = "white", size = 4)
age_group
age_plot = slp_df %>%
filter(weekday_slp_hr<6) %>%
mutate(text_label = str_c("Age: $", age, "\nGender: ", gender)) %>%
plot_ly(
x = ~weekday_slp_time, y = ~weekday_wake_time, type = "scatter", mode = "markers",size = 15,
color = ~age, text = ~text_label, alpha = 0.5)
age_plot